home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / PCSSP.LZH / PC-SSP.ZIP / POLYOPS.ZIP / PECN.FOR < prev    next >
Text File  |  1985-11-29  |  3KB  |  97 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE PECN
  5. C
  6. C        PURPOSE
  7. C           ECONOMIZE A POLYNOMIAL FOR SYMMETRIC RANGE
  8. C
  9. C        USAGE
  10. C           CALL PECN (P,N,BOUND,EPS,TOL,WORK)
  11. C
  12. C        DESCRIPTION OF PARAMETERS
  13. C           P     - COEFFICIENT VECTOR OF GIVEN POLYNOMIAL
  14. C                   ON RETURN P CONTAINS THE ECONOMIZED POLYNOMIAL
  15. C           N     - DIMENSION OF COEFFICIENT VECTOR P
  16. C                   ON RETURN N CONTAINS DIMENSION OF ECONOMIZED
  17. C                   POLYNOMIAL
  18. C           BOUND - RIGHT HAND BOUNDARY OF RANGE
  19. C           EPS   - INITIAL ERROR BOUND
  20. C                   ON RETURN EPS CONTAINS AN ERROR BOUND FOR THE
  21. C                   ECONOMIZED POLYNOMIAL
  22. C           TOL   - TOLERANCE FOR ERROR
  23. C                   FINAL VALUE OF EPS MUST BE LESS THAN TOL
  24. C           WORK  - WORKING STORAGE OF DIMENSION N (STARTING VALUE
  25. C                   OF N RATHER THAN FINAL VALUE)
  26. C
  27. C        REMARKS
  28. C           THE OPERATION IS BYPASSED IN CASE OF N LESS THAN 1.
  29. C           IN CASE OF AN ARBITRARY INTERVAL (XL,XR) IT IS NECESSARY
  30. C           FIRST TO CALCULATE THE EXPANSION OF THE GIVEN POLYNOMIAL
  31. C           WITH ARGUMENT X IN POWERS OF T = (X-(XR-XL)/2).
  32. C           THIS IS ACCOMPLISHED THROUGH SUBROUTINE PCLD.
  33. C
  34. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  35. C           NONE
  36. C
  37. C        METHOD
  38. C           SUBROUTINE PECN TAKES AN (N-1)ST DEGREE POLYNOMIAL
  39. C           APPROXIMATION TO A FUNCTION F(X) VALID WITHIN A TOLERANCE
  40. C           EPS OVER THE INTERVAL (-BOUND,BOUND) AND REDUCES IT IF
  41. C           POSSIBLE TO A POLYNOMIAL OF LOWER DEGREE VALID WITHIN
  42. C           THE GIVEN TOLERANCE TOL.
  43. C           THE INITIAL COEFFICIENT VECTOR P IS REPLACED BY THE FINAL
  44. C           VECTOR. THE INITIAL ERROR BOUND EPS IS REPLACED BY A FINAL
  45. C           ERROR BOUND.
  46. C           N IS REPLACED BY THE DIMENSION OF THE REDUCED POLYNOMIAL.
  47. C           THE COEFFICIENT VECTOR OF THE N-TH CHEBYSHEV POLYNOMIAL
  48. C           IS CALCULATED FROM THE RECURSION FORMULA
  49. C           A(K-1)=-A(K+1)*K*L*L*(K-1)/((N+K-2)*(N-K+2))
  50. C           REFERENCE
  51. C           K. A. BRONS, ALGORITHM 38, TELESCOPE 2, CACM VOL. 4, 1961,
  52. C           NO. 3, PP. 151-152.
  53. C
  54. C     ..................................................................
  55. C
  56.       SUBROUTINE PECN(P,N,BOUND,EPS,TOL,WORK)
  57. C
  58.       DIMENSION P(1),WORK(1)
  59.       FL=BOUND*BOUND
  60. C
  61. C     TEST OF DIMENSION
  62. C
  63.     1 IF(N-1)2,3,6
  64.     2 RETURN
  65.     3 IF(EPS+ABS(P(1))-TOL)4,4,5
  66.     4 N=0
  67.       EPS=EPS+ABS(P(1))
  68.     5 RETURN
  69. C
  70. C     CALCULATE EXPANSION OF CHEBYSHEV POLYNOMIAL
  71. C
  72.     6 NEND=N-2
  73.       WORK(N)=-P(N)
  74.       DO 7 J=1,NEND,2
  75.       K=N-J
  76.       FN=(NEND-1+K)*(NEND+3-K)
  77.       FK=K*(K-1)
  78.     7 WORK(K-1)=-WORK(K+1)*FK*FL/FN
  79. C
  80. C     TEST FOR FEASIBILITY OF REDUCTION
  81. C
  82.       IF(K-2)8,8,9
  83.     8 FN=ABS(WORK(1))
  84.       GOTO 10
  85.     9 FN=N-1
  86.       FN=ABS(WORK(2)/FN)
  87.    10 IF(EPS+FN-TOL)11,11,5
  88. C
  89. C     REDUCE POLYNOMIAL
  90. C
  91.    11 EPS=EPS+FN
  92.       N=N-1
  93.       DO 12 J=K,N,2
  94.    12 P(J-1)=P(J-1)+WORK(J-1)
  95.       GOTO 1
  96.       END
  97.